home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 23 / CU Amiga - Super CD-ROM 23 (June 1998).iso / CreatingGames / Utilities / E / ScreenFX / ScreenFX.e next >
Encoding:
Text File  |  1996-05-20  |  11.8 KB  |  470 lines
  1.  
  2. /*
  3.  
  4.   on a boring weekend i tried how to code such screen effects some blankers
  5.   do while "blanking" the screen.
  6.   the result is this demonstration program written using wouters e (i guess
  7.   everybody should "translate" it into his/her favourit language)
  8.  
  9.   greez fly to Knuddel, "PackMAN" Falk Zühlsdorff, "Zet" Mathhias Zinke,
  10.   Marcus, the DOSen-Friix and any other who knows me (or even not ;)
  11.  
  12.   read the routines notes so can find tips for optimizing and making
  13.   more funny effects; the spot effect is "in work" so maybe ScreenFX 2
  14.   will follow with some more and other effect (write me if you have
  15.   suggestions!)
  16.  
  17.   the code is documented, but if you have any question you may mail:
  18.  
  19.             jt18@irz.inf.tu-dresden.de
  20.  
  21.   SPECIAL NOTE: USAGE IS YOUR OWN RISK!!!!! FAILURE OR LOST DATA ARE NOT
  22.                 MY FAULT.
  23.  
  24.   now have fun,
  25.   savage
  26.  
  27. */
  28.  
  29. MODULE 'intuition/intuitionbase',
  30.        'intuition/intuition',
  31.        'intuition/screens',
  32.        'graphics/gfx',
  33.        'graphics/view',
  34.        'graphics/rastport',
  35.        'graphics/videocontrol',
  36.        'exec/memory',
  37.        'hardware/blit'
  38.  
  39. ENUM BYE,MELT,BACKPOINTS,BLACKPOINTS,DISSOLVE,FADE,BLUR
  40.  
  41. ENUM DOWN=100,SWIM,SUCK
  42.  
  43. DEF copyscreen=NIL : PTR TO screen,
  44.     copyviewport=NIL : PTR TO viewport,
  45.     copywindow=NIL : PTR TO window,
  46.     rastport=NIL : PTR TO rastport,
  47.     numbercolors=0
  48.  
  49. PROC main()
  50.  
  51. DEF response
  52.  
  53.   -> init the rnd-generator
  54.   Rnd(-1)
  55.  
  56.   WHILE (response := req('Welcome to ScreenFX by Jens Tröger\n\n'+
  57.                          'This will show you how to program\n'+
  58.                          'several Effects like Blankers do.\n\n'+
  59.                          'USAGE IS YOUR OWN RISK !',
  60.                          'Melt|BackPoints|BlackPoints|Dissolve|Fade|Blur| Bye ')) <> BYE
  61.  
  62. /***************************************************************************
  63.  
  64.  the melt function use the BltBitMap() gfx function to blit random parts
  65.  of the source bitmap into the same bitmap; try different minterms
  66.  (mad: ANBNC OR ANBC ;)
  67.  
  68.  all other procs use simple gfx functions such like RectFill(), WritePixel(),
  69.  SetRGB4() and so on...
  70.  
  71.  ***************************************************************************/
  72.  
  73.  
  74.       -> the folowing will only call the routines (if nothing happens
  75.       -> copyFirstScreen() failed (i did *NO* error message handling!)
  76.       SELECT response
  77.  
  78.         CASE MELT
  79.  
  80.           response := req('Select type of melt...','Suck|Down|Swim')
  81.  
  82.           SELECT response
  83.             CASE 1
  84.  
  85.               IF copyFirstScreen()
  86.                 melt(SUCK, ABNC OR ABC)
  87.                 closeCopyScreen()
  88.               ENDIF
  89.  
  90.             CASE 2
  91.  
  92.               IF copyFirstScreen()
  93.                 melt(DOWN, ABNC OR ABC)
  94.                 closeCopyScreen()
  95.               ENDIF
  96.  
  97.             CASE 0
  98.  
  99.               IF copyFirstScreen()
  100.                 melt(SWIM, ABNC OR ABC)
  101.                 closeCopyScreen()
  102.               ENDIF
  103.               
  104.           ENDSELECT
  105.  
  106.         CASE BACKPOINTS
  107.  
  108.           IF copyFirstScreen()
  109.             backPoints()
  110.             closeCopyScreen()
  111.           ENDIF
  112.  
  113.         CASE BLACKPOINTS
  114.  
  115.           IF copyFirstScreen()
  116.             blackPoints()
  117.             closeCopyScreen()
  118.           ENDIF
  119.  
  120.         CASE DISSOLVE
  121.  
  122.           IF copyFirstScreen()
  123.             dissolve()
  124.             closeCopyScreen()
  125.           ENDIF
  126.  
  127.         CASE FADE
  128.  
  129.           IF copyFirstScreen()
  130.             fade()
  131.             closeCopyScreen()
  132.           ENDIF
  133.  
  134.         CASE BLUR
  135.  
  136.           IF copyFirstScreen()
  137.             blur()
  138.             closeCopyScreen()
  139.           ENDIF
  140.  
  141.       ENDSELECT
  142.  
  143.   ENDWHILE
  144.  
  145. ENDPROC
  146.  
  147. PROC copyFirstScreen()
  148.  
  149. /*
  150.     NOTE (taken from RKRM)
  151.     "An application may not steal the bitmap of a screen that it
  152.     does not own. Stealing the Workbench screen`s bitmap, or that
  153.     of any other public screen, is strictly illegal."
  154.  
  155.     NOTE
  156.     i should not draw into screens rastport directly so i open a
  157.     "fullsize" window and copy source-screens bitmap into windows
  158.     rastport
  159.  
  160.     NOTE
  161.     returns TRUE or FALSE, !!*NOT*!! the screen address!!!!
  162. */
  163.  
  164. -> define some variables as pointers
  165. DEF intbase=NIL: PTR TO intuitionbase,
  166.     iblock=NIL,
  167.     srcscreen=NIL: PTR TO screen,
  168.     srcbitmap=NIL: PTR TO bitmap,
  169.     srcviewport=NIL: PTR TO viewport,
  170.     srcrastport=NIL: PTR TO rastport,
  171.     srccolormap=NIL: PTR TO colormap
  172.  
  173.   -> so i can examine the intuitionbase
  174.   intbase := intuitionbase
  175.  
  176.   -> lock the intuitionbase and get the pointer to the frontmost
  177.   -> screen (firstscreen)
  178.   iblock := LockIBase(NIL)
  179.   srcscreen := intbase.firstscreen
  180.   UnlockIBase(iblock)
  181.  
  182.   -> initialize some pointers
  183.   srcrastport := srcscreen.rastport
  184.   srcbitmap := srcrastport.bitmap
  185.   srcviewport := srcscreen.viewport
  186.   srccolormap := srcviewport.colormap
  187.  
  188.   -> calc number of colors from screens depth
  189.   numbercolors := Shl(2,srcbitmap.depth-1)
  190.  
  191.   -> now open the screen
  192.   copyscreen := OpenScreenTagList(NIL,
  193.                                   [SA_LEFT,srcscreen.leftedge,
  194.                                    SA_TOP,0,
  195.                                    SA_WIDTH,srcscreen.width,
  196.                                    SA_HEIGHT,srcscreen.height,
  197.                                    SA_DEPTH,srcbitmap.depth,
  198.                                    SA_DISPLAYID,GetVPModeID(srcscreen.viewport),
  199.                                    SA_BEHIND,TRUE,
  200.                                    NIL])
  201.   IF copyscreen
  202.  
  203.     -> get the viewport OF the copyscreen
  204.     copyviewport := copyscreen.viewport
  205.  
  206.     -> set colors
  207.     LoadRGB4(copyscreen.viewport,srccolormap.colortable,srccolormap.count)
  208.  
  209.     copywindow := OpenWindowTagList(NIL,
  210.                                     [WA_LEFT,0,
  211.                                      WA_TOP,0,
  212.                                      WA_WIDTH,srcscreen.width,
  213.                                      WA_HEIGHT,srcscreen.height,
  214.                                      WA_BORDERLESS,TRUE,
  215.                                      WA_CUSTOMSCREEN,copyscreen,
  216.                                      NIL])
  217.     IF copywindow
  218.  
  219.       -> copy source-screens`s bitmap (disable task-switching)
  220.       Forbid()
  221.       BltBitMapRastPort(srcbitmap,0,0,
  222.                         copywindow.rport,0,0,
  223.                         copywindow.width,copywindow.height,
  224.                         $C0)
  225.       Permit()
  226.  
  227.       -> set the global rastport and the e-internal reastport
  228.       -> to my windows rastport
  229.       rastport := copywindow.rport
  230.       SetStdRast(copywindow.rport)
  231.  
  232.       -> pop the screen to front
  233.       ScreenToFront(copyscreen)
  234.  
  235.       RETURN TRUE
  236.  
  237.     ENDIF
  238.  
  239.     CloseScreen(copyscreen)
  240.  
  241.   ENDIF
  242.  
  243. ENDPROC FALSE
  244. PROC closeCopyScreen()
  245.  
  246.   -> move the screen to back and close the window and screen
  247.   ScreenToBack(copyscreen)
  248.   CloseWindow(copywindow)
  249.   CloseScreen(copyscreen)
  250.  
  251. ENDPROC
  252. PROC borderOff()
  253.  
  254.   -> switch off the border
  255.   VideoControl(copyviewport.colormap,[VTAG_BORDERBLANK_SET,0,NIL])
  256.  
  257.   -> now refresh the display (RethinkDisplay() is not enough :)
  258.   RemakeDisplay()
  259.  
  260. ENDPROC
  261. PROC req(text, gads)
  262.  
  263.   -> simply set up a intuition requester and return its response
  264.   RETURN EasyRequestArgs(NIL,[20,0,'ScreenFX by Jens Tröger',text,gads]:LONG,NIL,NIL)
  265.  
  266. ENDPROC
  267.  
  268. PROC blur()
  269.  
  270. DEF x,y
  271.  
  272.   WHILE Not(LeftMouse(copywindow))
  273.  
  274.     -> get a random pixel of my screen...
  275.     x := Rnd(copyscreen.width)
  276.     y := Rnd(copyscreen.height)
  277.  
  278.     -> ...find and set its color as apen...
  279.     SetAPen(rastport, ReadPixel(rastport,x,y))
  280.  
  281.     -> ...and paint a little rect in this color
  282.     RectFill(rastport,x,y,x+1,y+1)
  283.  
  284.   ENDWHILE
  285.  
  286. ENDPROC
  287. PROC fade()
  288.  
  289. -> NOTE: you will get a smoother fading if you do not set every register
  290. ->       itself by calling SetRGB4() but creating a own colormap via
  291. ->       GetColorMap(), fill it an after this call LoadRGB4()
  292.  
  293. -> inspirated by Holger Gzella (thanx Holger: are you in Germany again??)
  294.  
  295. DEF fade=TRUE,count,color,red,green,blue
  296.  
  297.   -> fade will be set to TRUE if one of the color registers is
  298.   -> not zero (black)
  299.   WHILE (fade = TRUE) AND (Not(LeftMouse(copywindow)))
  300.  
  301.     -> do with every color register starting by 0
  302.     FOR count := 0 TO numbercolors-1
  303.  
  304.       -> get color register`s color
  305.       -> NOTE: all are 4-bit-rgb-values!
  306.       color := GetRGB4(copyviewport.colormap,count)
  307.  
  308.       -> if color is not black get the parts of it (red, green, blue)
  309.       -> with shifting and masking the bits and count down these values
  310.       IF color > 0
  311.  
  312.         -> get the parts
  313.         red := Shr(And(color,$0f00),8)
  314.         green := Shr(And(color,$00f0),4)
  315.         blue := And(color,$000f)
  316.  
  317.         -> count down
  318.         IF (red>=blue) AND (red>=green) AND (red>0) THEN red--
  319.         IF (green>=blue) AND (green>=red) AND (green>0) THEN green--
  320.         IF (blue>=red) AND (blue>=green) AND (blue>0) THEN blue--
  321.  
  322.         -> set the new (a little darker) color
  323.         SetRGB4(copyviewport,count,red,green,blue)
  324.  
  325.         -> wait a little time (5 x 1/50s)
  326.         Delay(5)
  327.  
  328.         -> set fade to true for a new loop
  329.         fade := TRUE
  330.  
  331.       ELSE
  332.  
  333.         -> all (or the last) are black!
  334.         fade := FALSE
  335.  
  336.       ENDIF
  337.  
  338.     ENDFOR
  339.  
  340.   ENDWHILE
  341.  
  342. ENDPROC
  343. PROC dissolve()
  344.  
  345. DEF x,y
  346.  
  347.   WHILE Not(LeftMouse(copywindow))
  348.  
  349.     -> get a random pixel
  350.     x := Rnd(copyscreen.width)
  351.     y := Rnd(copyscreen.height)
  352.  
  353.     -> mask the bitplanes using Rnd()
  354.     rastport.mask := Rnd(numbercolors+1)
  355.  
  356.     -> scroll my random rect (size is 5x5) in a random direction
  357.     -> (direction is max 5 pixel horizontal and/or vertical)
  358.     ScrollRaster(rastport,Rnd(5), Rnd(5),x,y,x+5,y+5)
  359.  
  360.   ENDWHILE                                                  
  361.  
  362. ENDPROC
  363. PROC blackPoints()
  364.  
  365.   -> use black as draw-pen (hope reg 1 will hold black!!!, otherwise
  366.   -> use the pen-array given by the draw-info structure to find the
  367.   -> darkest color)
  368.   SetAPen(rastport,1)
  369.  
  370.   -> switch off the border
  371.   borderOff()
  372.  
  373.   WHILE Not(LeftMouse(copywindow))
  374.  
  375.     -> draw and draw and draw black pixels
  376.     WritePixel(rastport,Rnd(copyscreen.width),Rnd(copyscreen.height))
  377.  
  378.   ENDWHILE
  379.  
  380. ENDPROC
  381. PROC backPoints()
  382.  
  383.   -> if reg 0 holds the background pen this will work otherwise use the
  384.   -> draw-info BACKGROUNDPEN
  385.   SetAPen(rastport,0)
  386.  
  387.   WHILE Not(LeftMouse(copywindow))
  388.  
  389.     -> draw and draw "invisible" pixels
  390.     WritePixel(rastport,Rnd(copyscreen.width),Rnd(copyscreen.height))
  391.  
  392.   ENDWHILE
  393.  
  394. ENDPROC
  395.  
  396. PROC melt(mode,minterm)
  397.  
  398. -> this code was inspirated/taken from "MELT.C" by Stephen Coy and
  399. -> modified for different effects
  400.  
  401. DEF mask,x,y,u,v,dx,dy,temp
  402.  
  403.   -> BltBitMap() needs some CHIP-Mem as a temporary memory
  404.   -> if there are overlapping blits
  405.   IF (temp := NewM(MAXBYTESPERROW, MEMF_CHIP OR MEMF_CLEAR)) = NIL THEN RETURN
  406.  
  407.   -> do melting while the LMB is not pressed
  408.   WHILE Not(LeftMouse(copywindow))
  409.  
  410.     -> bitplane mask
  411.     mask := 1
  412.  
  413.     REPEAT
  414.  
  415.       -> get the dimension of the blit-rect and its
  416.       -> position
  417.       u := Rnd((copyscreen.width-3)/2)+1
  418.       v := Rnd((copyscreen.height-3)/2)+1
  419.       x := Rnd(copyscreen.width-1-u)+1
  420.       y := Rnd(copyscreen.height-2-v)+1
  421.  
  422.       -> check what melt and randowmize the
  423.       -> dirction
  424.       IF mode = DOWN
  425.         dx := Rnd(3)-1
  426.         dy := Rnd(3)
  427.       ELSEIF mode = SWIM
  428.         dx := Rnd(3)-1
  429.         dy := Rnd(3)-1
  430.       ELSEIF mode = SUCK
  431.         IF (x < (copyscreen.width / 2))
  432.           IF (y < (copyscreen.height / 2))
  433.             dx := Rnd(3)
  434.             dy := Rnd(3)
  435.           ELSE
  436.             dx := Rnd(3)
  437.             dy := - Rnd(3)-2
  438.           ENDIF
  439.         ELSE
  440.           IF (y < (copyscreen.height / 2))
  441.             dx := - Rnd(3)-2
  442.             dy := Rnd(3)
  443.           ELSE
  444.             dx := - Rnd(3)-2
  445.             dy := - Rnd(3)-2
  446.           ENDIF
  447.         ENDIF
  448.       ENDIF
  449.  
  450.       -> now blit the rect
  451.       -> ZET-NOTE (and other friix): replace mask with $FFFFFFFF  ;0)
  452.       BltBitMap(rastport.bitmap, x, y,
  453.                 rastport.bitmap, x+dx, y+dy,
  454.                 u, v, minterm, mask, temp);
  455.  
  456.       -> activate next bitplanes
  457.       mask ++
  458.  
  459.     UNTIL mask >= (numbercolors-1)
  460.  
  461.   ENDWHILE
  462.  
  463.   -> free the temporary memory
  464.   Dispose(temp)
  465.  
  466. ENDPROC
  467.  
  468.  
  469.  
  470.